home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / access / TKNLIB.MAC.f < prev    next >
Encoding:
Text File  |  1993-10-04  |  39.4 KB  |  1,100 lines
  1. C
  2. C  Revised Token stream access functions -  version 1.
  3. C
  4. C  GENERAL
  5. C  ------
  6. C
  7. C  ZTOKTX  Return the expanded text of a token, i.e. the string
  8. C          that it actually represents
  9. C  ZTOKNM  Return a string containing the name of a token.
  10. C
  11. C
  12. C  INPUT
  13. C  -----
  14. C
  15. C  ZTKGTI  Initialise input from a given source.
  16. C  ZTKGTQ  Terminate input from a given source.
  17. C  ZSCAN   Get the next token, the token is derived from
  18. C          the source file using the scanner.
  19. C  ZGETTK  Get the next token from the specified file or from
  20. C          the internal buffer written by ZUSCAN.
  21. C
  22. C
  23. C  OUTPUT
  24. C  ------
  25. C
  26. C  ZTKPTI  Initialise output to a given source.
  27. C  ZTKPTQ  Terminate output to a given source.
  28. C  ZUSCAN  Put the next token to a temporary buffer, when the buffer
  29. C          is full then flush it via POLISH, which uses ZGETTK.
  30. C  ZPUTTK  Put the next token to the specified files.
  31. C
  32. C
  33. C  LOW LEVEL ROUTINES
  34. C  ------------------
  35. C
  36. C  XTKADD  Add a character to an internal buffer, flush to
  37. C          a file if full.
  38. C  XTKSUB  Get a character from an internal buffer, refill
  39. C          from a file if empty.
  40. C  XTKBUF  Internal buffer for ZUSCAN/ZGETTK communication.
  41. C
  42. C----------------------------------------------------------
  43. C
  44. C       Z T O K T X  -  Convert token from stream into text
  45. C
  46. C       STATUS : INTEGER (result) -- err/ok
  47. C       TYPE   : INTEGER    Type of token from ZTREAD/ZTOKRD
  48. C       LENGTH : INTEGER    Length of associated text string
  49. C       STRING : INTEGER(*) Associated text string
  50. C       TEXT   : INTEGER(*) Resultant text
  51. C
  52.         INTEGER FUNCTION ZTOKTX(TYPE,LENGTH,STRING,TEXT)
  53.  
  54. C---------------------------------------------------------
  55. C    TOOLPACK/1    Release: 2.4
  56. C---------------------------------------------------------
  57. C
  58. C  TKLAST = LAST TOKEN NUMBER
  59. C
  60.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  61.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  62.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  63.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  64.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  65.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  66.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  67.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  68.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  69.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  70.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  71.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  72.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  73.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  74.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  75.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  76.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  77.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  78.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  79.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  80.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  81.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  82.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  83.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  84.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  85.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  86.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  87.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  88.  
  89.         INTEGER TYPE,LENGTH,STRING(*),TEXT(*)
  90.         INTEGER TOKTXT(488),INDEX(TKLAST),I,J
  91.         SAVE
  92.  
  93.         INTEGER ITOC
  94.         EXTERNAL ITOC
  95.  
  96.         DATA (TOKTXT(I),I=1,74)/60,101,111,102,62,129,
  97.      +      65,83,83,73,71,78,32,129,
  98.      +      66,65,67,75,83,80,65,67,69,32,129,
  99.      +      66,76,79,67,75,32,68,65,84,65,32,129,
  100.      +      67,65,76,76,32,129,
  101.      +      67,76,79,83,69,32,129,
  102.      +      67,79,77,77,79,78,32,129,
  103.      +      67,79,78,84,73,78,85,69,32,129,
  104.      +      68,65,84,65,32,129/
  105.         DATA(TOKTXT(I),I=75,152)/68,79,32,129,
  106.      +      68,73,77,69,78,83,73,79,78,32,129,
  107.      +      69,76,83,69,129,
  108.      +      69,76,83,69,73,70,129,129,
  109.      +      69,78,68,129,
  110.      +      69,78,68,70,73,76,69,32,129,
  111.      +      69,78,68,73,70,129,129,
  112.      +      69,78,84,82,89,32,129,
  113.      +      69,81,85,73,86,65,76,69,78,67,69,
  114.      +32,129,
  115.      +      69,88,84,69,82,78,65,76,32,129/
  116.         DATA(TOKTXT(I),I=153,217)/
  117.      +      70,85,78,67,84,73,79,78,32,129,
  118.      +      70,79,82,77,65,84,32,129,
  119.      +      71,79,84,79,32,129,129,
  120.      +      73,70,32,129,
  121.      +      73,77,80,76,73,67,73,84,32,129,
  122.      +      73,78,81,85,73,82,69,32,129,
  123.      +      73,78,84,82,73,78,83,73,67,32,129,
  124.      +      79,80,69,78,32,129/
  125.         DATA(TOKTXT(I),I=218,279)/
  126.      +      80,65,82,65,77,69,84,69,82,32,129,
  127.      +      80,65,85,83,69,32,129,
  128.      +      80,82,73,78,84,32,129,
  129.      +      80,82,79,71,82,65,77,32,129,
  130.      +      82,69,65,68,32,129,
  131.      +      82,69,84,85,82,78,32,129,
  132.      +      82,69,87,73,78,68,32,129,
  133.      +      83,65,86,69,32,129/
  134.         DATA(TOKTXT(I),I=280,347)/83,84,79,80,32,129,
  135.      +      83,85,66,82,79,85,84,73,78,69,32,129,
  136.      +      84,72,69,78,32,129,
  137.      +      84,79,32,129,
  138.      +      87,82,73,84,69,32,129,
  139.      +      73,78,84,69,71,69,82,32,129,
  140.      +      82,69,65,76,32,129,
  141.      +      68,79,85,66,76,69,32,80,82,69,67,
  142.      +73,83,73,79,78,32,129/
  143.         DATA(TOKTXT(I),I=348,406)/
  144.      +      67,79,77,80,76,69,88,32,129,
  145.      +      76,79,71,73,67,65,76,32,129,
  146.      +      67,72,65,82,65,67,84,69,82,32,129,
  147.      +      44,129,61,129,58,129,40,129,41,129,
  148.      +      46,76,69,46,129,
  149.      +      46,76,84,46,129,
  150.      +      46,69,81,46,129,
  151.      +      46,78,69,46,129/
  152.         DATA(TOKTXT(I),I=407,460)/46,71,69,46,129,
  153.      +      46,71,84,46,129,
  154.      +      46,65,78,68,46,129,
  155.      +      46,79,82,46,129,
  156.      +      46,69,81,86,46,129,
  157.      +      46,78,69,81,86,46,129,
  158.      +      46,78,79,84,46,129,
  159.      +      42,129,42,42,129,43,129,45,129,
  160.      +      47,129,47,47,129/
  161.         DATA(TOKTXT(I),I=461,473)/129,
  162.      +      70,77,84,129,
  163.      +      69,78,68,129,
  164.      +      69,82,82,129/
  165.         DATA(TOKTXT(I),I=474,488)/68,79,85,66,76,69,32,
  166.      +      67,79,77,80,76,69,88,129/
  167.  
  168.         DATA INDEX/1,7,15,26,38,44,51,59,69,75,79,90,95,103,107,116,123,
  169.      +130,143,153,163,171,178,182,192,201,212,218,229,236,243,252,258,
  170.      +266,274,280,286,298,304,308,315,324,330,348,357,366,474,377,379,
  171.      +381,383,385,387,392,397,402,407,412,417,423,428,434,441,447,449,
  172.      +452,454,456,458,461,461,461,461,461,461,461,461,461,461,461,462,
  173.      +466,470/
  174.  
  175.         IF (TYPE.EQ.TCCNST) THEN
  176.             J=2
  177.             TEXT(1)=39
  178.             DO 200 I=1,LENGTH
  179.                 TEXT(J)=STRING(I)
  180.                 J=J+1
  181.                 IF (STRING(I).EQ.39) THEN
  182.                     TEXT(J)=39
  183.                     J=J+1
  184.                 END IF
  185.  200        CONTINUE
  186.             TEXT(J)=39
  187.             TEXT(J+1)=129
  188.         ELSE IF (TYPE.EQ.THCNST) THEN
  189.             I=ITOC(LENGTH,TEXT,12)+1
  190.             TEXT(I)=72
  191.             DO 400 J=1,LENGTH
  192.  400            TEXT(J+I)=STRING(J)
  193.             TEXT(I+LENGTH+1)=129
  194.         ELSE IF (LENGTH.GT.0) THEN
  195.             DO 100 I=1,LENGTH
  196.  100            TEXT(I)=STRING(I)
  197.             TEXT(LENGTH+1)=129
  198.         ELSE
  199.             I=1
  200.  300        TEXT(I)=TOKTXT(I+INDEX(TYPE)-1)
  201.             I=I+1
  202.             IF (TEXT(I-1).NE.129) GOTO 300
  203.         END IF
  204.         ZTOKTX=-2
  205.  
  206.         END
  207. C-------------------------------------------------
  208. C
  209. C       Z T O K N M  -  Return the name of a token
  210. C
  211. C       STATUS : INTEGER (result) -- err/ok
  212. C       TYPE   : INTEGER    Type of token (numeric value)
  213. C       TEXT   : INTEGER(*) Resultant text
  214. C
  215.         INTEGER FUNCTION ZTOKNM(TYPE, TEXT)
  216.  
  217. C---------------------------------------------------------
  218. C    TOOLPACK/1    Release: 2.4
  219. C---------------------------------------------------------
  220. C
  221. C  TKLAST = LAST TOKEN NUMBER
  222. C
  223.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  224.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  225.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  226.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  227.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  228.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  229.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  230.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  231.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  232.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  233.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  234.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  235.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  236.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  237.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  238.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  239.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  240.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  241.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  242.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  243.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  244.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  245.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  246.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  247.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  248.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  249.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  250.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  251.  
  252.         INTEGER TYPE
  253.         INTEGER TEXT(*), TXT(7, TKLAST)
  254.         SAVE
  255.  
  256.         DATA (TXT(I,TZEOF),I=1,7)/84,90,69,79,70,32,129/
  257.         DATA (TXT(I,TASSIG),I=1,7)/84,65,83,83,73,71,129/
  258.         DATA (TXT(I,TBACKS),I=1,7)/84,66,65,67,75,83,129/
  259.         DATA (TXT(I,TBLOCK),I=1,7)/84,66,76,79,67,75,129/
  260.         DATA (TXT(I,TCALL),I=1,7)/84,67,65,76,76,32,129/
  261.         DATA (TXT(I,TCLOSE),I=1,7)/84,67,76,79,83,69,129/
  262.         DATA (TXT(I,TCOMMO),I=1,7)/84,67,79,77,77,79,129/
  263.         DATA (TXT(I,TCONTI),I=1,7)/84,67,79,78,84,73,129/
  264.         DATA (TXT(I,TDATA),I=1,7)/84,68,65,84,65,32,129/
  265.         DATA (TXT(I,TDO),I=1,7)/84,68,79,32,32,32,129/
  266.         DATA (TXT(I,TDIMEN),I=1,7)/84,68,73,77,69,78,129/
  267.         DATA (TXT(I,TELSE),I=1,7)/84,69,76,83,69,32,129/
  268.         DATA (TXT(I,TELSIF),I=1,7)/84,69,76,83,73,70,129/
  269.         DATA (TXT(I,TEND),I=1,7)/84,69,78,68,32,32,129/
  270.         DATA (TXT(I,TENDFI),I=1,7)/84,69,78,68,70,73,129/
  271.         DATA (TXT(I,TENDIF),I=1,7)/84,69,78,68,73,70,129/
  272.         DATA (TXT(I,TENTRY),I=1,7)/84,69,78,84,82,89,129/
  273.         DATA (TXT(I,TEQUIV),I=1,7)/84,69,81,85,73,86,129/
  274.         DATA (TXT(I,TEXTER),I=1,7)/84,69,88,84,69,82,129/
  275.         DATA (TXT(I,TFUNCT),I=1,7)/84,70,85,78,67,84,129/
  276.         DATA (TXT(I,TFORMA),I=1,7)/84,70,79,82,77,65,129/
  277.         DATA (TXT(I,TGOTO),I=1,7)/84,71,79,84,79,32,129/
  278.         DATA (TXT(I,TIF),I=1,7)/84,73,70,32,32,32,129/
  279.         DATA (TXT(I,TIMPLI),I=1,7)/84,73,77,80,76,73,129/
  280.         DATA (TXT(I,TINQUI),I=1,7)/84,73,78,81,85,73,129/
  281.         DATA (TXT(I,TINTRI),I=1,7)/84,73,78,84,82,73,129/
  282.         DATA (TXT(I,TOPEN),I=1,7)/84,79,80,69,78,32,129/
  283.         DATA (TXT(I,TPARAM),I=1,7)/84,80,65,82,65,77,129/
  284.         DATA (TXT(I,TPAUSE),I=1,7)/84,80,65,85,83,69,129/
  285.         DATA (TXT(I,TPRINT),I=1,7)/84,80,82,73,78,84,129/
  286.         DATA (TXT(I,TPROGR),I=1,7)/84,80,82,79,71,82,129/
  287.         DATA (TXT(I,TREAD),I=1,7)/84,82,69,65,68,32,129/
  288.         DATA (TXT(I,TRETUR),I=1,7)/84,82,69,84,85,82,129/
  289.         DATA (TXT(I,TREWIN),I=1,7)/84,82,69,87,73,78,129/
  290.         DATA (TXT(I,TSAVE),I=1,7)/84,83,65,86,69,32,129/
  291.         DATA (TXT(I,TSTOP),I=1,7)/84,83,84,79,80,32,129/
  292.         DATA (TXT(I,TSUBRO),I=1,7)/84,83,85,66,82,79,129/
  293.         DATA (TXT(I,TTHEN),I=1,7)/84,84,72,69,78,32,129/
  294.         DATA (TXT(I,TTO),I=1,7)/84,84,79,32,32,32,129/
  295.         DATA (TXT(I,TWRITE),I=1,7)/84,87,82,73,84,69,129/
  296.         DATA (TXT(I,TINTEG),I=1,7)/84,73,78,84,69,71,129/
  297.         DATA (TXT(I,TREAL),I=1,7)/84,82,69,65,76,32,129/
  298.         DATA (TXT(I,TDOUBL),I=1,7)/84,68,79,85,66,76,129/
  299.         DATA (TXT(I,TCOMPL),I=1,7)/84,67,79,77,80,76,129/
  300.         DATA (TXT(I,TLOGIC),I=1,7)/84,76,79,71,73,67,129/
  301.         DATA (TXT(I,TCHARA),I=1,7)/84,67,72,65,82,65,129/
  302.         DATA (TXT(I,TDCMPL),I=1,7)/84,68,67,77,80,76,129/
  303.         DATA (TXT(I,TCOMMA),I=1,7)/84,67,79,77,77,65,129/
  304.         DATA (TXT(I,TEQUAL),I=1,7)/84,69,81,85,65,76,129/
  305.         DATA (TXT(I,TCOLON),I=1,7)/84,67,79,76,79,78,129/
  306.         DATA (TXT(I,TLPARN),I=1,7)/84,76,80,65,82,78,129/
  307.         DATA (TXT(I,TRPARN),I=1,7)/84,82,80,65,82,78,129/
  308.         DATA (TXT(I,TLE),I=1,7)/84,76,69,32,32,32,129/
  309.         DATA (TXT(I,TLT),I=1,7)/84,76,84,32,32,32,129/
  310.         DATA (TXT(I,TEQ),I=1,7)/84,69,81,32,32,32,129/
  311.         DATA (TXT(I,TNE),I=1,7)/84,78,69,32,32,32,129/
  312.         DATA (TXT(I,TGE),I=1,7)/84,71,69,32,32,32,129/
  313.         DATA (TXT(I,TGT),I=1,7)/84,71,84,32,32,32,129/
  314.         DATA (TXT(I,TAND),I=1,7)/84,65,78,68,32,32,129/
  315.         DATA (TXT(I,TOR),I=1,7)/84,79,82,32,32,32,129/
  316.         DATA (TXT(I,TEQV),I=1,7)/84,69,81,86,32,32,129/
  317.         DATA (TXT(I,TNEQV),I=1,7)/84,78,69,81,86,32,129/
  318.         DATA (TXT(I,TNOT),I=1,7)/84,78,79,84,32,32,129/
  319.         DATA (TXT(I,TSTAR),I=1,7)/84,83,84,65,82,32,129/
  320.         DATA (TXT(I,TDSTAR),I=1,7)/84,68,83,84,65,82,129/
  321.         DATA (TXT(I,TPLUS),I=1,7)/84,80,76,85,83,32,129/
  322.         DATA (TXT(I,TMINUS),I=1,7)/84,77,73,78,85,83,129/
  323.         DATA (TXT(I,TSLASH),I=1,7)/84,83,76,65,83,72,129/
  324.         DATA (TXT(I,TCNCAT),I=1,7)/84,67,78,67,65,84,129/
  325.         DATA (TXT(I,TDCNST),I=1,7)/84,68,67,78,83,84,129/
  326.         DATA (TXT(I,TLCNST),I=1,7)/84,76,67,78,83,84,129/
  327.         DATA (TXT(I,TRCNST),I=1,7)/84,82,67,78,83,84,129/
  328.         DATA (TXT(I,TPCNST),I=1,7)/84,80,67,78,83,84,129/
  329.         DATA (TXT(I,TCCNST),I=1,7)/84,67,67,78,83,84,129/
  330.         DATA (TXT(I,THCNST),I=1,7)/84,72,67,78,83,84,129/
  331.         DATA (TXT(I,TNAME),I=1,7)/84,78,65,77,69,32,129/
  332.         DATA (TXT(I,TFIELD),I=1,7)/84,70,73,69,76,68,129/
  333.         DATA (TXT(I,TSCALE),I=1,7)/84,83,67,65,76,69,129/
  334.         DATA (TXT(I,TZEOS),I=1,7)/84,90,69,79,83,32,129/
  335.         DATA (TXT(I,TCMMNT),I=1,7)/84,67,77,77,78,84,129/
  336.         DATA (TXT(I,TFMTKD),I=1,7)/84,70,77,84,75,68,129/
  337.         DATA (TXT(I,TENDKD),I=1,7)/84,69,78,68,75,68,129/
  338.         DATA (TXT(I,TERRKD),I=1,7)/84,69,82,82,75,68,129/
  339.  
  340.         IF((TYPE .LE. 0) .OR. (TYPE .GT. TKLAST)) THEN
  341.           CALL REMARK('ZTOKNM: INVALID TYPE ARGUMENT')
  342.           TEXT(1) = 129
  343.           ZTOKNM = -1
  344.           RETURN
  345.  
  346.         ELSE
  347.           CALL SCOPY(TXT(1, TYPE), 1, TEXT, 1)
  348.           ZTOKNM = -2
  349.  
  350.         ENDIF
  351.  
  352.         END
  353. C----------------------------------------------------
  354. C
  355. C  INITIALISE TOKEN INPUT.
  356. C
  357. C  TYPE = 0   INPUT USING A SCANNER, ALL TOKEN INPUT WILL BE PERFORMED
  358. C             USING CALLS TO ZSCAN
  359. C  TYPE = 1   INPUT USING TOKEN READ FROM A FILE
  360. C  TYPE = 2   INPUT FROM AN INTERNAL BUFFER. INPUT
  361. C             IS DONE USING ZGETTK, THE BUFFER IS FILLED BY ZUSCAN
  362. C
  363.       INTEGER FUNCTION ZTKGTI(TYPE, FD1, FD2)
  364.  
  365.       INTEGER  FD1, FD2, TYPE
  366.       LOGICAL  FIRST
  367.  
  368.       INTEGER LIMIT, MAXSET, LENT, SIZE
  369.       PARAMETER (LIMIT = 4, SIZE = 132, LENT = SIZE + 2)
  370.  
  371.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  372.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  373.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  374.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  375.      +        LSTTKN, INTYP, MAXSET
  376.  
  377.       INTEGER I
  378.       SAVE
  379.  
  380.       DATA FIRST/.TRUE./
  381.  
  382.       ZTKGTI = -1
  383.       IF(FIRST) THEN
  384.         FIRST  = .FALSE.
  385.         MAXSET = 0
  386.         DO 10 I = 1, LIMIT
  387.           INTYP(I) = -100
  388.    10   CONTINUE
  389.       ENDIF
  390. C
  391. C  CHECK LEGALITY, ONLY 'LIMIT' STREAM PAIRS ARE ALLOWED, OF WHICH ONLY
  392. C  ONE MAY BE OF TYPE=0.
  393. C
  394.       IF(MAXSET .EQ. LIMIT) RETURN
  395.       IF(TYPE .LT. 0) RETURN
  396.       IF(TYPE .EQ. 0) THEN
  397.         DO 20 I = 1, LIMIT
  398.           IF(INTYP(I) .EQ. 0) RETURN
  399.    20   CONTINUE
  400.       ENDIF
  401.  
  402.       IF(TYPE .EQ. 0) THEN
  403.         IF(FD1 .GT. 0) CALL SEEK(0, FD1)
  404.       ELSE IF(TYPE .NE. 2) THEN
  405.         IF(FD1 .GT. 0) CALL SEEK(0, FD1)
  406.         IF(FD2 .GT. 0) CALL SEEK(0, FD2)
  407.       ENDIF
  408.  
  409.       MAXSET = MAXSET + 1
  410.       DO 30 I = 1, LIMIT
  411.         IF(INTYP(I) .EQ. -100) THEN
  412.           INTYP(I)  = TYPE
  413.           FDTOKS(I) = FD1
  414.           FDCMTS(I) = FD2
  415.           TPOINT(I) = LENT + 1
  416.           CPOINT(I) = LENT + 1
  417.           LSTTKN(I) = 0
  418.  
  419.           ZTKGTI = I
  420.           RETURN
  421.         ENDIF
  422.    30 CONTINUE
  423.  
  424.       END
  425. C----------------------------------------------------
  426. C
  427. C  TERMINATE TOKEN INPUT.
  428. C
  429.       SUBROUTINE ZTKGTQ(CHAN)
  430.  
  431.       INTEGER  CHAN
  432.       INTEGER TKNTYP, TKNLEN, TKNSTR(1)
  433.  
  434.       INTEGER LIMIT, MAXSET, LENT, SIZE
  435.       PARAMETER (LIMIT = 4, SIZE = 132, LENT = SIZE + 2)
  436.  
  437.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  438.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  439.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  440.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  441.      +        LSTTKN, INTYP, MAXSET
  442.  
  443.       SAVE
  444.  
  445.       IF(INTYP(CHAN) .EQ. 0) THEN
  446.            CALL XSCN77 (FDTOKS(CHAN), FDCMTS(CHAN),
  447.      +               TKNTYP, TKNLEN, TKNSTR, -101)
  448.       ENDIF
  449.       INTYP(CHAN) = -100
  450.       MAXSET = MAX(MAXSET-1, 0)
  451.  
  452.       END
  453. C----------------------------------------------------
  454. C
  455. C  INITIALISE TOKEN OUTPUT.
  456. C
  457. C  TYPE = 0   OUTPUT TO AN INTERNAL BUFFER, WHICH IS FLUSHED VIA POLISH
  458. C             WHEN FULL.
  459. C  TYPE > 0   OUTPUT TO A TOKEN STREAM AND COMMENT FILE PAIR.
  460. C
  461.       INTEGER FUNCTION ZTKPTI(TYPE, FD1, FD2)
  462.  
  463.       INTEGER  FD1, FD2, TYPE
  464.       LOGICAL  FIRST
  465.  
  466.       INTEGER LIMIT, MAXSET, LENT, SIZE
  467.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  468.  
  469.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  470.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  471.      +        LSTTKN(LIMIT), OUTTYP(LIMIT), JUNK1, JUNK2
  472.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  473.      +        LSTTKN, OUTTYP, MAXSET
  474.       INTEGER INIT, SINCE,TKNFIL
  475.       COMMON /XCTKSV/ INIT,SINCE,TKNFIL
  476.       SAVE
  477.       INTEGER I
  478.  
  479.       DATA FIRST/.TRUE./
  480.  
  481.       ZTKPTI = -1
  482.       IF(FIRST) THEN
  483.         MAXSET = 0
  484.         FIRST = .FALSE.
  485.         DO 10 I = 1, LIMIT
  486.           OUTTYP(I) = -100
  487.    10   CONTINUE
  488.       ENDIF
  489. C
  490. C  CHECK LEGALITY, ONLY 2 STREAM PAIRS ARE ALLOWED, OF WHICH ONLY
  491. C  ONE MAY BE OF TYPE=0.
  492. C
  493.       IF(MAXSET .EQ. LIMIT) RETURN
  494.       IF(TYPE .LT. 0) RETURN
  495.       IF(TYPE .EQ. 0) THEN
  496.         DO 20 I = 1, LIMIT
  497.           IF(OUTTYP(I) .EQ. 0) RETURN
  498.    20   CONTINUE
  499.       ENDIF
  500.  
  501.       IF(FD1 .GT. 0) CALL SEEK(0, FD1)
  502.       IF(TYPE .NE. 0) THEN
  503.         IF(FD2 .GT. 0) CALL SEEK(0, FD2)
  504.       ELSE
  505.         CALL XTKBUF(0, JUNK1, TPOINT, JUNK2, INIT)
  506.         INIT  = 0
  507.         SINCE = -32767
  508.       ENDIF
  509.  
  510.       MAXSET = MAXSET + 1
  511.       DO 30 I = 1, LIMIT
  512.         IF(OUTTYP(I) .EQ. -100) THEN
  513.           OUTTYP(I) = TYPE
  514.           FDTOKS(I) = FD1
  515.           FDCMTS(I) = FD2
  516.           TPOINT(I) = 1
  517.           CPOINT(I) = 1
  518.           LSTTKN(I) = 0
  519.  
  520.           ZTKPTI = I
  521.           RETURN
  522.         ENDIF
  523.    30 CONTINUE
  524.  
  525.       END
  526. C----------------------------------------------------
  527. C
  528. C  TERMINATE TOKEN OUTPUT.
  529. C
  530.       SUBROUTINE ZTKPTQ(CHAN)
  531.  
  532.       INTEGER  CHAN
  533.  
  534.       INTEGER LIMIT, MAXSET, LENT, SIZE
  535.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  536.  
  537.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  538.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  539.      +        LSTTKN(LIMIT), OUTTYP(LIMIT)
  540.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  541.      +        LSTTKN, OUTTYP, MAXSET
  542.  
  543.       SAVE
  544.  
  545.       OUTTYP(CHAN) = -100
  546.       MAXSET = MAX(MAXSET-1, 0)
  547.  
  548.       END
  549. C----------------------------------------------------
  550. C
  551. C  READ A TOKEN FROM A TOKEN STREAM/COMMENT FILE PAIR THAT
  552. C  HAVE BEEN INITIALISED USING ZTOKIN. THIS ROUTINE IS VERY
  553. C  SIMILAR TO ZTREAD BUT ALLOWS MULTIPLE PAIRS OF FILES
  554. C  TO BE IN USE AT THE SAME TIME.
  555. C
  556.       SUBROUTINE ZGETTK (TYPE, LENGTH, STRING, CNTRL, STATUS)
  557. C
  558. C---------------------------------------------------------
  559. C    TOOLPACK/1    Release: 2.4
  560. C---------------------------------------------------------
  561. C
  562. C  TKLAST = LAST TOKEN NUMBER
  563. C
  564.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  565.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  566.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  567.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  568.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  569.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  570.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  571.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  572.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  573.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  574.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  575.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  576.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  577.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  578.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  579.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  580.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  581.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  582.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  583.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  584.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  585.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  586.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  587.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  588.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  589.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  590.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  591.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  592.  
  593.       INTEGER TYPE, CNTRL, FIRST, SECOND, C, LENGTH,
  594.      +        I, STATUS
  595.       INTEGER STRING (*)
  596.  
  597.       INTEGER LIMIT, MAXSET, LENT, SIZE
  598.       PARAMETER (LIMIT = 4, SIZE = 132, LENT = SIZE + 2)
  599.  
  600.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  601.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  602.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  603.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  604.      +        LSTTKN, INTYP, MAXSET
  605.       SAVE
  606. C
  607. C  CHECK THE LEGALITY OF THE REQUEST
  608. C
  609.       IF(CNTRL .LE. 0 .OR. CNTRL .GT. MAXSET) THEN
  610.         CALL REMARK('ZGETTK: CNTRL ARGUMENT OUT OF RANGE')
  611.         STATUS = -1
  612.         RETURN
  613.       ELSE IF(INTYP(CNTRL) .EQ. 0) THEN
  614.         CALL REMARK('ZGETTK: INVALID CNTRL ARGUMENT (INACTIVE STREAM)')
  615.         STATUS = -1
  616.         RETURN
  617.       ENDIF
  618.  
  619.       IF(INTYP(CNTRL) .EQ. 2) THEN
  620.           CALL XTKBUF(2, TYPE, STRING, LENGTH, STATUS)
  621.           RETURN
  622.       ENDIF
  623.  
  624.     5 CONTINUE
  625.       IF(LSTTKN(CNTRL) .EQ. TCMMNT) THEN
  626.         CALL XTKSUB(FIRST, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  627.      +              SIZE, FDCMTS(CNTRL), STATUS)
  628.         IF(STATUS .NE. -2) RETURN
  629.         CALL XTKSUB(SECOND, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  630.      +              SIZE, FDCMTS(CNTRL), STATUS)
  631.         IF(STATUS .NE. -2) RETURN
  632.  
  633.         LENGTH = (FIRST-48)*10 + SECOND - 48
  634.         DO 10 I = 1, LENGTH
  635.           CALL XTKSUB(C,  CPOINT(CNTRL), CMTBUF(1,CNTRL),
  636.      +              SIZE, FDCMTS(CNTRL), STATUS)
  637.           IF(STATUS .NE. -2) RETURN
  638.           STRING(I) = C
  639.    10   CONTINUE
  640.         STRING(I) = 129
  641.         TYPE = TCMMNT
  642.         IF(LENGTH .NE. 1) RETURN
  643.         IF(STRING(1) .NE. 36) RETURN
  644.  
  645.       ENDIF
  646.  
  647.       CALL XTKSUB(FIRST,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  648.      +              SIZE, FDTOKS(CNTRL), STATUS)
  649.       IF(STATUS .NE. -2) RETURN
  650.       CALL XTKSUB(SECOND,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  651.      +              SIZE, FDTOKS(CNTRL), STATUS)
  652.       IF(STATUS .NE. -2) RETURN
  653.  
  654.       TYPE = (FIRST-48)*10 + SECOND - 48
  655.       IF(TYPE .EQ. TCMMNT) THEN
  656.         LSTTKN(CNTRL) = TCMMNT
  657.         GO TO 5
  658.       ENDIF
  659.  
  660.       LENGTH = 0
  661.       DO 20 I = 1, 5
  662.         CALL XTKSUB(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  663.      +              SIZE, FDTOKS(CNTRL), STATUS)
  664.         IF(STATUS .NE. -2) RETURN
  665.         IF(FIRST .EQ. 32) GO TO 22
  666.         LENGTH = 10*LENGTH + FIRST-48
  667.    20 CONTINUE
  668.  
  669.    22 CONTINUE
  670.       DO 30 I = 1, LENGTH
  671.         CALL XTKSUB(C, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  672.      +              SIZE, FDTOKS(CNTRL), STATUS)
  673.         IF(STATUS .NE. -2) RETURN
  674.         STRING(I) = C
  675.    30 CONTINUE
  676.       STRING(I) = 129
  677.  
  678.       LSTTKN(CNTRL) = TYPE
  679.  
  680.       END
  681. C----------------------------------------------------------
  682. C
  683. C  INTERFACE FOR THE ROUTINE HELD IN SCNLB2.MAC
  684. C
  685. C  CHECK TO SEE IF THE DESCRIPTOR PASSED REFERS TO A LEGAL
  686. C  BUFFER PAIR AND THAT THAT PAIR IS AVAILABLE FOR SCANNING
  687. C  ACCESS
  688. C
  689.       SUBROUTINE ZSCAN(TKNTYP, TKNLEN, TKNSTR, DESC, STATUS)
  690.  
  691.       INTEGER TKNTYP, TKNLEN, TKNSTR(*), DESC, STATUS
  692.  
  693.       INTEGER LIMIT, MAXSET, LENT, SIZE
  694.       PARAMETER (LIMIT = 4, SIZE = 132, LENT = SIZE + 2)
  695.  
  696.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  697.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  698.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  699.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  700.      +        LSTTKN, INTYP, MAXSET
  701.       SAVE
  702.  
  703.       IF(DESC .LE. 0 .OR. DESC .GT. MAXSET) THEN
  704.         CALL REMARK('ZSCAN: DESC ARGUMENT OUT OF RANGE')
  705.         STATUS = -1
  706.  
  707.       ELSE IF(INTYP(DESC) .NE. 0) THEN
  708.         CALL ERROR('ZSCAN: DESC ARGUMENT NAMES AN INACTIVE STREAM')
  709.         STATUS = -1
  710.  
  711.       ELSE
  712.         STATUS = -2
  713.         CALL XSCN77 (FDTOKS(DESC), FDCMTS(DESC),
  714.      +               TKNTYP, TKNLEN, TKNSTR, STATUS)
  715.         TKNSTR(TKNLEN+1) = 129
  716.       ENDIF
  717.  
  718.       END
  719. C----------------------------------------------------
  720. C
  721. C  PUT A TOKEN OUT TO AN EXTERNAL FILE.....
  722. C
  723.       SUBROUTINE ZPUTTK(TYPE, LENGTH, STRING, CNTRL)
  724.  
  725.       INTEGER TYPE, LENGTH, CNTRL, I, FIRST, SECOND, THIRD,
  726.      +        FOURTH, ACTLEN
  727.       INTEGER STRING(*)
  728.  
  729. C---------------------------------------------------------
  730. C    TOOLPACK/1    Release: 2.4
  731. C---------------------------------------------------------
  732. C
  733. C  TKLAST = LAST TOKEN NUMBER
  734. C
  735.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  736.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  737.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  738.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  739.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  740.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  741.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  742.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  743.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  744.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  745.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  746.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  747.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  748.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  749.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  750.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  751.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  752.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  753.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  754.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  755.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  756.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  757.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  758.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  759.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  760.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  761.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  762.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  763.  
  764.  
  765.       INTEGER LIMIT, MAXSET, LENT, SIZE
  766.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  767.  
  768.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  769.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  770.      +        LSTTKN(LIMIT), OUTTYP(LIMIT)
  771.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  772.      +        LSTTKN, OUTTYP, MAXSET
  773.       SAVE
  774.  
  775.       IF(CNTRL .LE. 0 .OR. CNTRL .GT. MAXSET) RETURN
  776.       IF(OUTTYP(CNTRL) .LE. 0) RETURN
  777.  
  778.       IF(TYPE .EQ. TCMMNT) THEN
  779.         IF(LSTTKN(CNTRL) .NE. TCMMNT) THEN
  780.           FIRST  = TYPE/10
  781.           SECOND = TYPE - (FIRST*10) + 48
  782.           FIRST  = FIRST + 48
  783.           CALL XTKADD(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  784.      +                SIZE, FDTOKS(CNTRL))
  785.           CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  786.      +                SIZE, FDTOKS(CNTRL))
  787.         ENDIF
  788.         ACTLEN = LENGTH
  789.     5   IF(STRING(ACTLEN) .EQ. 32) THEN
  790.           ACTLEN = ACTLEN - 1
  791.           IF(ACTLEN .GT. 0) GO TO 5
  792.         ENDIF
  793.         IF(ACTLEN .EQ. 0) THEN
  794.           CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  795.      +                SIZE, FDCMTS(CNTRL))
  796.           CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  797.      +                SIZE, FDCMTS(CNTRL))
  798.         ELSE
  799.           FIRST  = ACTLEN/10
  800.           SECOND = ACTLEN - (FIRST*10) + 48
  801.           FIRST  = FIRST + 48
  802.           CALL XTKADD(FIRST, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  803.      +                SIZE, FDCMTS(CNTRL))
  804.           CALL XTKADD(SECOND, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  805.      +                SIZE, FDCMTS(CNTRL))
  806.           DO 10 I = 1, ACTLEN
  807.             CALL XTKADD(STRING(I), CPOINT(CNTRL), CMTBUF(1,CNTRL),
  808.      +                SIZE, FDCMTS(CNTRL))
  809.    10     CONTINUE
  810.         ENDIF
  811.  
  812.       ELSE
  813.         IF(LSTTKN(CNTRL) .EQ. TCMMNT) THEN
  814.           CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  815.      +                SIZE, FDCMTS(CNTRL))
  816.           CALL XTKADD(49, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  817.      +                SIZE, FDCMTS(CNTRL))
  818.           CALL XTKADD(36, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  819.      +                SIZE, FDCMTS(CNTRL))
  820.         ENDIF
  821.         FIRST  = TYPE/10
  822.         SECOND = TYPE - (FIRST*10) + 48
  823.         FIRST  = FIRST + 48
  824.         CALL XTKADD(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  825.      +              SIZE, FDTOKS(CNTRL))
  826.         CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  827.      +              SIZE, FDTOKS(CNTRL))
  828.  
  829.         FIRST  =  LENGTH/1000
  830.         SECOND = (LENGTH - (FIRST*1000))/100
  831.         THIRD  = (LENGTH - (FIRST*1000) - (SECOND*100))/10
  832.         FOURTH =  LENGTH - (FIRST*1000) - (SECOND*100) - (THIRD*10)
  833.         FIRST  = FIRST + 48
  834.         SECOND = SECOND + 48
  835.         THIRD  = THIRD + 48
  836.         FOURTH = FOURTH + 48
  837.         IF(FIRST .NE. 48) THEN
  838.           CALL XTKADD(FIRST , TPOINT(CNTRL), TKNBUF(1,CNTRL),
  839.      +                SIZE, FDTOKS(CNTRL))
  840.           CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  841.      +                SIZE, FDTOKS(CNTRL))
  842.           CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  843.      +                SIZE, FDTOKS(CNTRL))
  844.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  845.      +                SIZE, FDTOKS(CNTRL))
  846.         ELSE IF(SECOND .NE. 48) THEN
  847.           CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  848.      +                SIZE, FDTOKS(CNTRL))
  849.           CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  850.      +                SIZE, FDTOKS(CNTRL))
  851.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  852.      +                SIZE, FDTOKS(CNTRL))
  853.         ELSE IF(THIRD .NE. 48) THEN
  854.           CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  855.      +                SIZE, FDTOKS(CNTRL))
  856.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  857.      +                SIZE, FDTOKS(CNTRL))
  858.         ELSE IF(FOURTH .NE. 48) THEN
  859.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  860.      +                SIZE, FDTOKS(CNTRL))
  861.         ENDIF
  862.         CALL XTKADD(32, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  863.      +                SIZE, FDTOKS(CNTRL))
  864.         DO 20 I = 1, LENGTH
  865.           CALL XTKADD(STRING(I), TPOINT(CNTRL), TKNBUF(1,CNTRL),
  866.      +                SIZE, FDTOKS(CNTRL))
  867.    20   CONTINUE
  868.  
  869.         IF(TYPE .EQ. TZEOF) THEN
  870.           I = TPOINT(CNTRL)
  871.           CALL XTKADD(32,TPOINT(CNTRL),TKNBUF(1,CNTRL),I,FDTOKS(CNTRL))
  872.           I = CPOINT(CNTRL)
  873.           CALL XTKADD(32,CPOINT(CNTRL),CMTBUF(1,CNTRL),I,FDCMTS(CNTRL))
  874.         ENDIF
  875.  
  876.       ENDIF
  877.  
  878.       LSTTKN(CNTRL) = TYPE
  879.  
  880.       END
  881. C----------------------------------------------------------
  882. C
  883. C  INTERFACE FOR THE ROUTINES HELP IN PLLIB. THIS IS THE POLISHING
  884. C  OUTPUT ROUTINE.
  885. C
  886.       SUBROUTINE ZUSCAN(TKNTYP, TKNLEN, TKNSTR, DESC)
  887.  
  888.       INTEGER TKNTYP, TKNLEN, TKNSTR(*), DESC
  889.       LOGICAL NOTDON
  890. C---------------------------------------------------------
  891. C    TOOLPACK/1    Release: 2.4
  892. C---------------------------------------------------------
  893. C
  894. C  TKLAST = LAST TOKEN NUMBER
  895. C
  896.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  897.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  898.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  899.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  900.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  901.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  902.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  903.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  904.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  905.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  906.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  907.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  908.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  909.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  910.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  911.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  912.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  913.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  914.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  915.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  916.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  917.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  918.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  919.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  920.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  921.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  922.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  923.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  924.  
  925.       INTEGER LIMIT, MAXSET, SIZE, LENT, STATUS
  926.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  927.  
  928.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  929.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  930.      +        LSTTKN(LIMIT), OUTTYP(LIMIT)
  931.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  932.      +        LSTTKN, OUTTYP, MAXSET
  933.  
  934.       INTEGER INIT, SINCE, TKNS
  935.       COMMON /XCTKSV/ INIT,SINCE, TKNS
  936.  
  937.       SAVE
  938.  
  939.       IF(DESC .LE. 0 .OR. DESC .GT. MAXSET) RETURN
  940.       IF(OUTTYP(DESC) .NE. 0) RETURN
  941.  
  942.       CALL XTKBUF(1, TKNTYP, TKNSTR, TKNLEN, STATUS)
  943.       IF(TKNTYP .EQ. TZEOS) SINCE = -1
  944.       SINCE = SINCE + 1
  945.  
  946.       IF(SINCE .GE. 2 .OR. TKNTYP .EQ. TZEOF) THEN
  947.         SINCE = -32767
  948.    10   CONTINUE
  949.           IF(INIT .EQ. 0) THEN
  950.             CALL INIPOL(FDCMTS(DESC), FDTOKS(DESC))
  951.             INIT = 1
  952.           ENDIF
  953.           CALL POLISH(NOTDON)
  954.           IF((NOTDON .AND. TKNTYP .EQ. TZEOF) .OR.
  955.      +       (TKNS .GT. 2)) GO TO 10
  956.  
  957.       ENDIF
  958.  
  959.       END
  960. C----------------------------------------------------
  961. C
  962. C  ADD THE SPECIFIED CHARACTER TO A BUFFER, FLUSH IT
  963. C  TO THE SPECIFIED FILE WHEN FULL.
  964. C
  965.       SUBROUTINE XTKADD(CHAR, POINT, BUFF, LIMIT, FD)
  966.  
  967.       INTEGER CHAR, POINT, LIMIT, FD, I
  968.       INTEGER BUFF(*)
  969.  
  970.       IF(FD .EQ. -1) RETURN
  971.       BUFF(POINT) = CHAR
  972.       POINT = POINT + 1
  973.       IF(POINT .GT. LIMIT) THEN
  974.         POINT = 1
  975.         DO 10 I = 1, LIMIT
  976.           CALL PUTCH(BUFF(I), FD)
  977.    10   CONTINUE
  978.         CALL PUTCH(10, FD)
  979.       ENDIF
  980.  
  981.       END
  982. C----------------------------------------------------
  983. C
  984. C  EXTRACT THE NEXT CHARACTER FROM A BUFFER, REFILL IT
  985. C  FROM THE SPECIFIED FILE WHEN EMPTY.
  986. C
  987.       SUBROUTINE XTKSUB(CHAR, POINT, BUFF, LIMIT, FD, STATUS)
  988.  
  989.       INTEGER CHAR, POINT, LIMIT, FD, I, STATUS
  990.       INTEGER BUFF(*)
  991.       INTEGER ZGTCMD
  992.  
  993.       IF(POINT .GT. LIMIT) THEN
  994.         POINT = 1
  995.         STATUS = ZGTCMD(BUFF, FD)
  996.         IF(STATUS .EQ. -1) RETURN
  997.         IF(STATUS .EQ. -100) CALL ERROR
  998.      +    ('XTKSUB - ATTEMPT TO READ PAST END OF TOKEN/COMMENT FILE')
  999.         DO 10 I = STATUS + 1, LIMIT
  1000.           BUFF(I) = 32
  1001.    10   CONTINUE
  1002.       ENDIF
  1003.  
  1004.       STATUS = -2
  1005.       CHAR = BUFF(POINT)
  1006.       POINT = POINT + 1
  1007.  
  1008.       END
  1009. C----------------------------------------------------
  1010. C
  1011. C  TOKEN STRING BUFFER FOR THE ZUSCAN/ZGETTK COMMUNICATION
  1012. C  BUFFERING MECHANISM. THE SIZE OF THE BUFFER MUST BE
  1013. C  SUFFICIENT FOR STORING A STATEMENT PLUS 2 TOKENS.
  1014. C  REMEMBER THAT A STATEMENT MAY HAVE ASSOCIATED WITH IT
  1015. C  QUITE A LOT OF COMMENT TEXT.
  1016. C
  1017.       SUBROUTINE XTKBUF(TYPE, TOKEN, CHARS, LENT, STATUS)
  1018.  
  1019.       INTEGER MAXBUF, BUFMOD, LENT, STATUS, TYPE, CHARS(*),
  1020.      +        TOKEN,I
  1021.       PARAMETER (MAXBUF=19999, BUFMOD=MAXBUF+1)
  1022.       INTEGER FREE, NEXTPT, NEXTGT, BUFFER(0:MAXBUF)
  1023.  
  1024.       INTEGER INIT, SINCE, TKNS
  1025.       COMMON /XCTKSV/ INIT,SINCE, TKNS
  1026.       SAVE
  1027. C
  1028. C  INITIALISE
  1029. C
  1030.       IF(TYPE .EQ. 0) THEN
  1031.         NEXTPT = 0
  1032.         NEXTGT = 0
  1033.         STATUS = -2
  1034.         FREE = BUFMOD
  1035.         TKNS = 0
  1036. C
  1037. C  WRITE
  1038. C
  1039.       ELSE IF(TYPE .EQ. 1) THEN
  1040.         IF(FREE .LT. LENT+2) THEN
  1041.           CALL REMARK('XTKBUF: TOKEN BUFFER FULL')
  1042.           STATUS = -1
  1043.         ELSE
  1044.           TKNS = TKNS + 1
  1045.           FREE = FREE - LENT - 2
  1046.           BUFFER(NEXTPT) = TOKEN
  1047.           IF(NEXTPT .GE. MAXBUF) THEN
  1048.             NEXTPT = 0
  1049.           ELSE
  1050.             NEXTPT = NEXTPT + 1
  1051.           ENDIF
  1052.  
  1053.           DO 10 I = 1, LENT+1
  1054.             BUFFER(NEXTPT) = CHARS(I)
  1055.             IF(NEXTPT .GE. MAXBUF) THEN
  1056.               NEXTPT = 0
  1057.             ELSE
  1058.               NEXTPT = NEXTPT + 1
  1059.             ENDIF
  1060.    10     CONTINUE
  1061.           STATUS = -2
  1062.         ENDIF
  1063. C
  1064. C  READ
  1065. C
  1066.       ELSE IF(TYPE .EQ. 2) THEN
  1067.         IF(FREE .GE. BUFMOD) THEN
  1068.           CALL REMARK('XTKBUF: TOKEN BUFFER EMPTY')
  1069.           STATUS = -1
  1070.         ELSE
  1071.           TKNS = TKNS - 1
  1072.           TOKEN = BUFFER(NEXTGT)
  1073.           IF(NEXTGT .GE. MAXBUF) THEN
  1074.             NEXTGT = 0
  1075.           ELSE
  1076.             NEXTGT = NEXTGT + 1
  1077.           ENDIF
  1078.           LENT = 0
  1079.    20     CONTINUE
  1080.             LENT = LENT + 1
  1081.             CHARS(LENT) = BUFFER(NEXTGT)
  1082.             IF(NEXTGT .GE. MAXBUF) THEN
  1083.               NEXTGT = 0
  1084.             ELSE
  1085.               NEXTGT = NEXTGT + 1
  1086.             ENDIF
  1087.           IF(CHARS(LENT) .NE. 129) GO TO 20
  1088.           FREE = FREE + LENT + 1
  1089.           LENT = LENT - 1
  1090.           STATUS = -2
  1091.         ENDIF
  1092.  
  1093.       ELSE
  1094.         CALL REMARK('XTKBUF: INVALID REQUEST')
  1095.         STATUS = -1
  1096.  
  1097.       ENDIF
  1098.  
  1099.       END
  1100.